home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Oberon⁄F™ 1.1 / Obx / Mod / MacPICTView (.txt) < prev    next >
Encoding:
Oberon Document  |  1996-01-05  |  3.1 KB  |  87 lines  |  [oODC/obnF]
  1. Documents.StdDocumentDesc
  2. Documents.DocumentDesc
  3. Containers.ViewDesc
  4. Views.ViewDesc
  5. Stores.StoreDesc
  6. Documents.ModelDesc
  7. Containers.ModelDesc
  8. Models.ModelDesc
  9. Stores.ElemDesc
  10. TextViews.StdViewDesc
  11. TextViews.ViewDesc
  12. TextModels.StdModelDesc
  13. TextModels.ModelDesc
  14. TextModels.AttributesDesc
  15. Helvetica
  16. Helvetica
  17. Helvetica
  18. DevCommanders.StdViewDesc
  19. DevCommanders.ViewDesc
  20. MODULE ObxMacPICTView;    (* od jul-93, ip nov-94 *)
  21. (* A sample Oberon/L program that shows how to open and display a Macintosh PICT file. *)
  22. (* In this demo app error checking is reduced to a minimum in favor of readability! *)
  23.     IMPORT
  24.         SYSTEM,
  25.         QD := MacQuickDraw , FS := MacFileMgr, FN := MacFontMgr, MW := MacWindowMgr,
  26.         MN := MacMenuMgr, TE := MacTextEdit, DL := MacDialogMgr, MT := MacTypes,
  27.         EV := MacEventMgr, ME := MacMemoryMgr;
  28.     PROCEDURE InitMac;
  29.     BEGIN
  30.         QD.InitGraf(QD.globals.thePort);
  31.         (* The QuickDraw Globals are proper Oberon Variables *)
  32.         FN.InitFonts;
  33.         MW.InitWindows;
  34.         MN.InitMenus;
  35.         TE.TEInit;
  36.         DL.InitDialogs(0);
  37.         QD.InitCursor
  38.     END InitMac;
  39.     PROCEDURE OpenPict;
  40.         VAR
  41.             myTypes: FS.SFTypeList;
  42.             myReply: FS.StandardFileReply;
  43.             myRef: INTEGER;
  44.             fsize: LONGINT;
  45.             myPic: QD.PicHandle;
  46.             err: INTEGER;
  47.             myWindow: MW.WindowPtr;
  48.     BEGIN
  49.         myTypes[0] := 50494354H;    (* PICT *)
  50.         FS.StandardGetFile(NIL, 1, myTypes, myReply);
  51.         IF myReply.sfGood THEN
  52.             err := FS.FSpOpenDF(myReply.sfFile, 0, myRef);
  53.             err := FS.GetEOF(myRef, fsize);
  54.             err := FS.SetFPos(myRef, 1, 512);
  55.             DEC(fsize, 512);    (* strip PICT-header *)
  56.             myPic  :=  SYSTEM.VAL(QD.PicHandle, ME.NewHandle(fsize));
  57.             IF myPic#NIL THEN
  58.                 err := FS.FSRead(myRef, fsize, SYSTEM.VAL(MT.Ptr, SYSTEM.ADR(myPic.picSize)));
  59.                 err := FS.FSClose(myRef);
  60.                 myWindow := MW.NewWindow(NIL, QD.globals.screenBits.bounds, '', TRUE, 1,
  61.                                                             SYSTEM.VAL(MW.WindowPtr, -1), FALSE, 0);
  62.                 QD.SetPort(myWindow);
  63.                 QD.OffsetRect(myPic.picFrame, -myPic.picFrame.left, -myPic.picFrame.top);
  64.                 QD.DrawPicture(myPic, myPic.picFrame);
  65.                 REPEAT UNTIL EV.Button();
  66.                 MW.DisposeWindow(myWindow)
  67.             END
  68.         END
  69.     END OpenPict;
  70. BEGIN
  71.     InitMac;
  72.     OpenPict;
  73. END ObxMacPICTView.
  74.  DevCompiler.Compile
  75.  DevLinker.Link ":Obx:MacPICTView" +ObxMacPICTView >ObxMacPICTView
  76. TextControllers.StdCtrlDesc
  77. TextControllers.ControllerDesc
  78. Containers.ControllerDesc
  79. Controllers.ControllerDesc
  80. TextRulers.StdRulerDesc
  81. TextRulers.RulerDesc
  82. TextRulers.StdStyleDesc
  83. TextRulers.StyleDesc
  84. TextRulers.AttributesDesc
  85. Helvetica
  86. Documents.ControllerDesc
  87.